unit ceCommon;

interface

uses ceConsts, Classes, Math;

const
  MAXLIST = Maxint div 16;

type
  PPtrList = ^TPtrList;
  TPtrList = array[1..1] of pointer;

  TCompareFunc = function(Item1, Item2: Pointer): Integer;

  TzList = class
  private
    FLocked: boolean;
    FList: PPtrList;
    FCount: longword;
    FCapacity: longword;
    FOnChange: TNotifyEvent;
    procedure Grow;
    function Get(Index: longword): Pointer;
    procedure Put(Index: longword; Item: Pointer);
    procedure SetCapacity(Value: longword);
    procedure SetCount(Value: longword);
  public
    destructor Destroy; override;
    function Add(Item: pointer): longword; overload;
    procedure Exchange(Index1, Index2: longword);
    procedure Insert(Index: longword; Item: pointer);
    procedure DeleteIndex(Index: longword);
    procedure Delete(Index: longword); virtual;
    procedure Move(CurIndex, NewIndex: longword);
    procedure Clear;
    procedure ClearIndexes;
    function IndexOf(Item: pointer): longword;
    property Count: longword read FCount write SetCount;
    property Item[Index: longword]: pointer read Get write Put; default;
    procedure Sort(Compare: TCompareFunc);
    property Capacity: longword read FCapacity write SetCapacity;
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

function Win1250ToWideChar(const c: Char): WideChar;
function Win1252ToWideChar(const c: Char): WideChar;
function Win1251ToWideChar(const c: Char): WideChar;
function Win1257ToWideChar(const c: Char): WideChar;

implementation

procedure ListSort(SortList: PPtrList; l, r: longword; Compare: TListSortCompare);
var
  i, j: longword;
  p, t: Pointer;
begin
  if l >= r then
    Exit;
  repeat
    i := l;
    j := r;
    p := SortList^[(l + r) shr 1];
    repeat
      while Compare(SortList^[i], p) < 0 do
        Inc(i);
      while Compare(SortList^[j], p) > 0 do
        Dec(j);
      if i <= j then
      begin
        t := SortList^[i];
        SortList^[i] := SortList^[j];
        SortList^[j] := t;
        Inc(i);
        Dec(j);
      end;
    until i > j;
    if l < j then
      ListSort(SortList, l, j, Compare);
    l := i;
  until i >= r;
end;


{ TzList }

function TzList.Add(Item: pointer): longword;
begin
  Inc(FCount);
  if FCount > FCapacity then Grow;
  FList^[FCount] := Item;
  Result := FCount;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TzList.Clear;
begin
  while Count <> 0 do Delete(Count);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TzList.ClearIndexes;
begin
  SetCount(0);
  SetCapacity(0);
end;

procedure TzList.Delete(Index: longword);
begin
  if (Index = 0) or (Index > FCount) then Exit;
  if Assigned(FList[Index]) then
    if TObject(FList[Index]) is TThread then
      TThread(FList[Index]).Terminate else
      TObject(FList[Index]).Free;
  DeleteIndex(Index);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TzList.DeleteIndex(Index: longword);
begin
  if (Index = 0) or (Index > FCount) then Exit;
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index], (FCount - Index) * SizeOf(Pointer));
  FList[FCount] := nil;
  Dec(FCount);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

destructor TzList.Destroy;
begin
  ClearIndexes;
  inherited;
end;

procedure TzList.Exchange(Index1, Index2: longword);
var
  Item: Pointer;
begin
  if Index1 <> Index2 then
    if (Index1 <> 0) and (Index1 <= FCount) then
      if (Index2 <> 0) and (Index2 <= FCount) then
      begin
        Item := FList^[Index1];
        FList^[Index1] := FList^[Index2];
        FList^[Index2] := Item;
      end;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TzList.Get(Index: longword): Pointer;
begin
  if (Index <> 0) and (Index <= FCount) then
    Result := FList^[Index] else
    Result := nil;
end;

procedure TzList.Grow;
var
  i: longword;
begin
  if FCapacity > 64 then
    i := FCapacity div 4 else
    if FCapacity > 8 then
      i := 16 else
      i := 4;
  SetCapacity(FCapacity + i);
end;

function TzList.IndexOf(Item: pointer): longword;
begin
  Result := 1;
  while (Result <= FCount) and (FList^[Result] <> Item) do
    Inc(Result);
  if Result > FCount then
    Result := 0;
end;

procedure TzList.Insert(Index: longword; Item: pointer);
begin
  if FCount = FCapacity then Grow;
  Index := Max(1, Index);
  if Index <= FCount then
    System.Move(FList^[Index], FList^[Index + 1], (FCount - Index + 1) * SizeOf(Pointer)) else
    Index := FCount + 1;
  FList^[Index] := Item;
  Inc(FCount);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TzList.Move(CurIndex, NewIndex: longword);
var
  Item: pointer;
begin
  if CurIndex <> NewIndex then
    if (NewIndex <> 0) and (NewIndex <= FCount) then
      if (CurIndex <> 0) and (CurIndex <= FCount) then
      begin
        Item := Get(CurIndex);
        DeleteIndex(CurIndex);
        Insert(NewIndex, Item);
      end;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TzList.Put(Index: longword; Item: Pointer);
begin
  if (Index <> 0) and (Index <= FCount) then
    FList^[Index] := Item;
end;

procedure TzList.SetCapacity(Value: longword);
begin
  if (Value >= FCount) and (Value <= MAXLIST) then
    if Value <> FCapacity then
    begin
      ReallocMem(FList, Value * SizeOf(Pointer));
      FCapacity := Value;
    end;
end;

procedure TzList.SetCount(Value: longword);
var
  i: longword;
begin
  if Value = FCount then Exit;
  if Value > MAXLIST then Exit;
  if Value > FCapacity then SetCapacity(Value);
  if Value > FCount then
    FillChar(FList^[FCount + 1], (Value - FCount) * SizeOf(Pointer), 0) else
    for i := FCount downto Value + 1 do DeleteIndex(i);
  FCount := Value;
end;

procedure TzList.Sort(Compare: TCompareFunc);
begin
  if Count > 1 then
    ListSort(FList, 1, Count, Compare);
end;

function Win1252ToWideChar(const c: Char): WideChar;
begin
  if Ord(c) in [$80..$9F] then
  begin
    Result := Win1252Map[Ord(c)];
    if Result = #$0000 then Result := '?';
  end else
    Result := WideChar(Ord(c));
end;

function Win1251ToWideChar(const c: Char): WideChar;
begin
  case Ord(c) of
    $00..$7F: Result := WideChar(Ord(c));
    $80..$BF:
      begin
        Result := Win1251Map[Ord(c)];
        if Result = #$0000 then Result := '?';
      end;
    $C0..$FF:
      Result := WideChar(Ord(c) + $0350);
  else
    Result := '?';
  end;
end;

function Win1257ToWideChar(const c: Char): WideChar;
begin
  case Ord(c) of
    $00..$7F: Result := WideChar(Ord(c));
    $80..$FF:
      begin
        Result := Win1257Map[Ord(c)];
        if Result = #$0000 then Result := '?';
      end;
  else
    Result := '?';
  end;
end;

function Win1250ToWideChar(const c: Char): WideChar;
begin
  if Ord(c) >= $80 then
  begin
    Result := Win1250Map[Ord(c)];
    if Result = #$0000 then Result := '?';
  end else
    Result := WideChar(Ord(c));
end;

end.

